   ' ******************************************************************

   ' ***  FFT11-03 *** POSITIVE FREQUENCY FFT ***

   'THIS PROGRAM SIMULATES A SPECTRUM ANALYZER USED TO ANALYZE DIGITAL

   'AUDIO FOR NON-LINEAR DISTORTION.  IT IS BASED ON THE ANALYZER OF

   'FFT09-02 AND INCLUDES THE LATEST PFFFT (FFT08-01).

   ' ******************************************************************

10 SCREEN 9, 1: COLOR 15, 1: CLS ' SETUP DISPLAY SCREEN

12 QX = 2 ^ 13: QI = 2 ^ 6: WSF = 16 / 5' MAX & NOM SIZE & S.F. CORR

14 N = 12: X0 = 50: Y0 = 15: ASF = 224

16 Q = 2 ^ N: N1 = N - 1: Q1 = Q - 1: Q2 = Q / 2: Q3 = Q2 - 1: Q4 = Q / 4

18 Q5 = Q4 - 1: Q8 = Q / 8: Q9 = Q8 - 1: Q34 = Q2 + Q4: Q16 = Q / 16

20 DIM C(QX), S(QX), KC(QX / 2), KS(QX / 2)

22 PI = 3.14159265358979#: P2 = PI * 2: K1 = P2 / Q

24 FSAP = 44100: NYQ = FSAP / 2: WTFLG = 2 ' SET WEIGHTING ON

26 XSF = 500 / Q2: KLOG = LOG(10): YSF = LOG(ASF) / KLOG: SK1 = 1

28 WEXP = 6: FRACF = 4 ' WEIGHTING EXP = 6 & FRAC FREQ = 1/4

30 AMP = 1: MAMP = 2 ^ 15: OVSAP = 2: T12 = 1.0594631#

32 GOSUB 900 ' SETUP SYSTEM

34 GOSUB 885 ' SET UP INITIAL ARRAY SIZE OF 2^10

36 GOTO 600



98  '         *****************************

100 '         ***   FORWARD TRANSFORM   ***

102 '         *****************************

106 '          ***  TRANSFORM STAGE 1  ***

110 C(0) = (S(0) + S(Q2)) / 2: C(1) = (S(0) - S(Q2)) / 2

112 FOR I = 1 TO Q3: I2 = 2 * I: INDX = 0 ' BIT REVERSE DATA ADDRESSES

114 FOR J = 0 TO N1: IF I AND 2 ^ J THEN INDX = INDX + 2 ^ (N - 2 - J)

116 NEXT J

118 C(I2) = (S(INDX) + S(INDX + Q2)) / 2: C(I2 + 1) = (S(INDX) - S(INDX + Q2)) / 2

120 NEXT I

122 FOR I = 0 TO Q1: S(I) = 0: NEXT I

'       *********  REMAINING STAGES  **********

124 FOR M = 1 TO N1: QP = 2 ^ M: QPI = 2 ^ (N1 - M)

126  FOR K = 0 TO QPI - 1

128   FOR J = 0 TO QP / 2: J0 = J + (2 * K * QP): J1 = J0 + QP: K2 = QPI * J

130   JI = J1 - (2 * J)

132   CTEMP1 = C(J0) + C(J1) * KC(K2) - S(J1) * KS(K2)

134   STEMP1 = S(J0) + C(J1) * KS(K2) + S(J1) * KC(K2)

136   CTEMP2 = C(J0) - C(J1) * KC(K2) + S(J1) * KS(K2)

138   S(JI) = (C(J1) * KS(K2) + S(J1) * KC(K2) - S(J0)) / 2

140   C(J0) = CTEMP1 / 2: S(J0) = STEMP1 / 2: C(JI) = CTEMP2 / 2

142   NEXT J

144  NEXT K

146 NEXT M

148 FOR J = Q2 + 1 TO Q1: C(J) = 0: S(J) = 0: NEXT J

152 GOSUB 350 ' DISPLAY SPECTRUM

154 RETURN



    ' **********************************

    ' *         PLOT SPECTRUM          *

    ' **********************************

350 CLS : LINE (X0 - 1, Y0)-(X0 - 1, Y0 + 330)' DRAW Y AXIS

352 LINE (X0, Y0 + 1)-(X0 + 500, Y0 + 1)' DRAW X AXIS

    '      **** DRAW 20 DB LINES ****

354 FOR I = 2 TO 14 STEP 2: YSKT = INT(YSF * 10 * LOG(1 / (10 ^ I)) / KLOG)

356 LINE (X0, Y0 - YSKT)-(X0 + 500, Y0 - YSKT)

358 YDB = CINT(.4 + (Y0 - YSKT) / 15.666): IF YDB > 25 THEN 362

360 LOCATE YDB, 2: PRINT USING "###."; 10 * I;

362 NEXT I

364 YP = SCALE * SQR(C(0) ^ 2 + S(0) ^ 2)   '  FIND RSS OF DATA POINT

366 IF YP = 0 THEN YP = -330: GOTO 370' OUT OF RANGE, SKIP

368 YP = 20 * LOG(YP) / KLOG' FIND DB VALUE

370 LINE (X0, Y0 - YSF * YP)-(X0, Y0 - YSF * YP)' SET PEN TO ORIGIN

372 FOR I = 0 TO Q3 ' *******    PLOT DATA POINTS    *******

374 YP = SCALE * SQR(C(I) ^ 2 + S(I) ^ 2)   '  FIND RSS OF DATA POINT

380 IF YP = 0 THEN YP = -160: GOTO 384' OUT OF RANGE, SKIP

382 YP = 20 * LOG(YP) / KLOG' FIND DB VALUE

384 LINE -(X0 + XSF * I, Y0 - YSF * YP)' DRAW LINE

386 NEXT I

388 LOCATE 1, 66: PRINT "F = "; : PRINT USING "#####.###"; F8

RETURN



    ' **********************************

    ' *      GENERATE SINE WAVE        *

    ' **********************************

400 FOR I = QDT TO Q: C(I) = 0: S(I) = 0: NEXT

402 Y = 0: ISAMP = 1

404 FOR I = 0 TO QDT: C(I) = 0

408 Y = INT(MAMP * AMP * SIN(F9 * K1 * I)) / MAMP

410 S(I) = Y

412 NEXT I

414 IF WTFLG = 2 THEN 450 ' USE WEIGHTING FUNCTION

420 RETURN

450 ' ****  WEIGHTING FUNCTION  ***

452 FOR I = 0 TO QDT

454 S(I) = S(I) * (SIN(I * PI / QDT) ^ WEXP)

456 NEXT I

458 RETURN



'     **********************************

600 ' ***     SPECTRUM ANALYZER      ***

    ' **********************************

602 CLS : PRINT : PRINT

604 INPUT "PLEASE SPECIFY STARTING FREQUENCY"; F8

606 F9 = F8 * FRACF * Q2 / NYQ

610 GOSUB 400 ' GENERATE SINUSOID

612 GOSUB 100 ' ANALYZE SPECTRUM

614 REPT = 0 ' RESET REPEAT FLAG

620 LOCATE 1, 40: PRINT "ESC TO CHANGE SYSTEM:";

622 A$ = INKEY$: IF A$ = "" THEN 632 ' USER INPUT?

624 IF ASC(A$) = 0 THEN GOSUB 650' CURSOR HAS LEADING ZERO

626 IF ASC(A$) = 27 THEN GOSUB 900

632 IF REPT = 1 THEN 612 ' ANALYZE SPECTRUM AGAIN

634 GOTO 606 ' CALCULATE NEW F9



650 ' ***  HANDLE CURSOR KEYS  ***

652 A = ASC(RIGHT$(A$, 1)) ' WHICH CURSOR

654 IF A < 72 OR A > 80 THEN 664 ' NOT A CURSOR KEY

656 IF A = 72 THEN AMP = AMP * 10: IF AMP > 1 THEN AMP = 1

658 IF A = 75 THEN F8 = F8 / T12' INC FREQUENCY

660 IF A = 77 THEN F8 = F8 * T12 ' DEC. FREQUENCY

662 IF A = 80 THEN AMP = AMP / 10: IF AMP < .00001 THEN AMP = .00001

663 GOSUB 670

664 F9 = F8 * FRACF * Q2 / NYQ' SCALE FOR CURRENT SYSTEM

666 GOSUB 400 ' GENERATE NEW SINUSOID

668 REPT = 1: RETURN ' SET REPEAT FLAG AND REPEAT

670 IF F8 < 2 * NYQ / (OVSAP * FRACF) THEN 676

672 LOCATE 10, 10: INPUT "FREQ OUT OF RANGE - ENTER TO CONTINUE"; B$

674 INPUT "PLEASE SELECT STARTING FREQ"; F8

676 RETURN



   '    ************************************************

   '    ********   ARRAY SIZE MENU (ANALYZER SETUP)   ********

   '    ************************************************

800 CLS : LOCATE 2, 30: PRINT "ANALYZER SETUP MENU"

802 LOCATE 6, 1' DISPLAY MENU

810 PRINT SPC(5); "1 = ANALYZE 64 POINT ARRAY": PRINT

812 PRINT SPC(5); "2 = ANALYZE 128 POINT ARRAY": PRINT

814 PRINT SPC(5); "3 = ANALYZE 256 POINT ARRAY": PRINT

816 PRINT SPC(5); "4 = ANALYZE 512 POINT ARRAY": PRINT

818 PRINT SPC(5); "5 = ANALYZE 1024 POINT ARRAY": PRINT

820 PRINT SPC(5); "6 = ANALYZE 2048 POINT ARRAY": PRINT

822 PRINT SPC(5); "7 = ANALYZE 4096 POINT ARRAY": PRINT

826 PRINT SPC(5); "9 = EXIT MENU": PRINT

828 PRINT SPC(10); "MAKE SELECTION: ";

830 A$ = INKEY$: IF A$ = "" THEN 830

832 IF ASC(A$) < 49 OR ASC(A$) > 57 THEN PRINT A$; " = INVALID KEY": GOTO 830

840 A = VAL(A$):

842 ON A GOSUB 850, 860, 865, 870, 875, 880, 885, 990, 990

844 RETURN

    ' *    SETUP FRACTIONAL FREQUENCY ANALYZER    *

850 N = 6: N1 = 5: Q = 2 ^ N ' SET ARRAY SIZE

852 QI = Q / FRACF: Q2 = Q / 2: Q3 = Q2 - 1: Q4 = Q / 4: Q5 = Q4 - 1

853 Q8 = Q / 8: Q9 = Q8 - 1: Q16 = Q / 16: Q34 = Q2 + Q4

854 F8 = 440: F9 = F8 * Q / QI: K1 = P2 / Q

585 QDT = Q / FRACF - 1 ' NEW TWIDDLES NEXT LINE

856 FOR I = 0 TO Q3: KC(I) = COS(K1 * I): KS(I) = SIN(K1 * I): NEXT

857 XSF = 500 * OVSAP / (QI * FRACF):  SCALE = WSF * FRACF * 2

858 RETURN ' BACK TO MAIN MENU



860 N = 7: N1 = 6: Q = 2 ^ N: GOTO 852

865 N = 8: N1 = 7: Q = 2 ^ N: GOTO 852

870 N = 9: N1 = 8: Q = 2 ^ N: GOTO 852

875 N = 10: N1 = 9: Q = 2 ^ N: GOTO 852

880 N = 11: N1 = 10: Q = 2 ^ N: GOTO 852

885 N = 12: N1 = 11: Q = 2 ^ N: GOTO 852



    '  ***********************

    '  *     SYSTEM SETUP    *

    '  ***********************

900 CLS : RTFLG = 1: PRINT SPC(20); "       SYSTEM SETUP MENU"

902 PRINT : LOCATE (5): PRINT "1 = SUMMARY               5 = ARRAY SIZE"

904 PRINT : PRINT "2 = WEIGHTING FUNCTION    6 = SET FREQUENCY"

906 PRINT : PRINT "3 = FRACTIONAL FREQUENCY"

907 PRINT : PRINT "4 = EXIT MENU             9 = TERMINATE PROGRAM"

908 PRINT : PRINT

910 A$ = INKEY$: IF A$ = "" THEN 910

912 A = ASC(A$): IF A < 49 OR A > 57 THEN 900

914 A = A - 48: ON A GOSUB 920, 930, 970, 990, 800, 960, 928, 928, 999

916 XSF = 500 * OVSAP / (QI * FRACF): SCALE = 2 * WSF * FRACF

918 ON RTFLG GOTO 900, 928

    ' ***  SHOW SYSTEM CONFIGURATION  ***

920 CLS

922 PRINT SPC(20); "SYSTEM SUMMARY": PRINT : PRINT

923 PRINT "FRACTIONAL FREQUENCY = 1/"; FRACF

924 PRINT "WEIGHTING FUNCTION = SIN^"; WEXP; " - WEIGHTING IS ";

925 IF WTFLG = 1 THEN PRINT "OFF" ELSE PRINT "ON"

926 PRINT "ARRAY SIZE IS "; Q: PRINT

927 INPUT "ENTER TO CONTINUE "; A$

928 RETURN



930 CLS : PRINT "WEIGHTING FUNCTION ON (Y/N)?";

932 A$ = INKEY$: IF A$ = "" THEN 932

934 IF A$ = "N" OR A$ = "n" THEN WTFLG = 1: WSF = 1: GOTO 956

936 WTFLG = 2: PRINT ' TURN WEIGHTING ON

938 PRINT "CHANGE WEIGHTING FUNCTION EXPONENT?"

940 A$ = INKEY$: IF A$ = "" THEN 940

942 IF A$ = "N" OR A$ = "n" THEN 956 ' EXIT

944 PRINT "1 = SIN^2": PRINT "2 = SIN^4": PRINT "3 = SIN^6"

946 A$ = INKEY$: IF A$ = "" THEN 946

948 A = ASC(A$): IF A < 49 OR A > 51 THEN 946

950 A = A - 48: WEXP = 2 * A

952 WSF = 2: IF A = 2 THEN WSF = 8 / 3

954 IF A = 3 THEN WSF = 16 / 5

956 RETURN

    ' ***  SET SAMPLING FREQUENCY  ***

960 INPUT "ENTER FREQUENCY OF SAMPLING RATE (IN SPS)"; FSAP

962 NYQ = FSAP / 2' NYQUIST = HALF SAMPLING RATE

964 RETURN



970 CLS : PRINT : PRINT "SELECT FRACTIONAL FREQUENCY FOR ANALYSIS"

972 PRINT : PRINT "1 = 1/1"; SPC(20); "4 = 1/8"

974 PRINT "2 = 1/2"; SPC(20); "5 = 1/16"

976 PRINT "3 = 1/4"; SPC(20); "6 = 1/32"

978 A$ = INKEY$: IF A$ = "" THEN 978

980 A = ASC(A$): IF A < 49 OR A > 54 THEN 978

982 A = A - 49: FRACF = 2 ^ A

984 A = N - 5: ON A GOSUB 850, 860, 865, 870, 875, 880, 885

986 RETURN



990 RTFLG = 2: RETURN

 ' **********

999 CLS : PRINT "ANY KEY TO CONTINUE": END: STOP' THAT'S ALL FOLKS



